home *** CD-ROM | disk | FTP | other *** search
/ PsL Monthly 1993 December / PSL Monthly Shareware CD-ROM (December 1993).iso / prgmming / dos / pascal / talk.com / TALKEDIT.PAS < prev    next >
Encoding:
Pascal/Delphi Source File  |  1989-04-23  |  8.2 KB  |  373 lines
  1. {$I+,F+}
  2. program TalkEdit;
  3. uses Crt;
  4.  
  5. const PhonemeSize = $023f;
  6.       MaxPhoneme = 35;
  7.       StartCol = 0;
  8.       StartRow = 0;
  9.       EndRow = 21;
  10.       EndCol = 19;
  11.       CmdRow = 24;
  12.       EditRow = 23;
  13.       EditCol = 1;
  14.       RemCol = 67;
  15.       PhCol = 1;
  16.       ByteCol = 28;
  17.       EdCol = 40;
  18.       TalkCol = 47;
  19.       SaveCol = 54;
  20.       SelectCol = 61;
  21.       MoreCol = 73;
  22.       PgUp = #201;
  23.       PgDo = #209;
  24.       UpAr = #200;
  25.       DoAr = #208;
  26.       LfAr = #203;
  27.       RiAr = #205;
  28.       Home = #199;
  29.       EKey = #207;
  30.  
  31. const SpeedDelay : word = 22;
  32.       Resolve : word = 1;
  33.       Snd : boolean = true;
  34.  
  35. type Satype = array[0..64000] of byte;
  36.      SaPtr = ^SaType;
  37.      string2 = string[2];
  38.  
  39. var ScreenMax:word;
  40.     MaxPhOfs:integer;
  41.     SaData : SaPtr;
  42.     f,fb : file;
  43.     Fsize,Result : word;
  44.     Pg,Ph,i:word;
  45.     CurCol,CurRow:word;
  46.     Key:char;
  47.     PhByte,PhOfs:word;
  48.  
  49. const
  50.     rdfile = 'TalkData.Bin';
  51.     bkfile = 'BackUp.Bin';
  52.  
  53. const
  54.     PhArray: array[1..35] of string2 =(
  55.                     'U',  'A',  ' ',  'B',  'D',  'G',
  56.                     'J',  'P',  'T',  'K',  'W',  'Y',
  57.                     'R',  'L',  'M',  'N',  'S',  'V',
  58.                     'F',  'H',  'Z',  'AW', 'AH', 'UH',
  59.                     'AE', 'OH', 'EH', 'OO', 'IH', 'EE',
  60.                     'WH', 'SH', 'TZ', 'TH', 'ZH' );
  61.  
  62. {$F+}
  63.   procedure Talker(Start:pointer; Size,Speed,Resolve:word; Snd:boolean);
  64.     external;
  65.   {$L Talker.OBJ}
  66.  
  67. {$F+}
  68.   procedure TalkDataLink; external;
  69.   {$L TalkData.OBJ}
  70.  
  71.  
  72. procedure TalkIt;
  73. begin
  74.    Talker(ptr( seg(TalkDataLink),ofs(TalkDataLink) + pred(Ph) * PhonemeSize ),
  75.                PhonemeSize, SpeedDelay, Resolve, Snd);
  76. end;
  77.  
  78. procedure ByteShow;
  79. begin
  80.    gotoxy(ByteCol,CmdRow);
  81.    write('Byte:    ');
  82.    gotoxy(ByteCol+5,CmdRow);
  83.    write(PhByte);
  84. end;
  85.  
  86. procedure ShowData;
  87. var OldCol,OldRow:word;
  88.     Mup,Mdo:char;
  89. begin
  90.    LowVideo;
  91.    OldCol := CurCol;
  92.    OldRow := CurRow;
  93.    CurCol := StartCol;
  94.    CurRow := StartRow;
  95.    for i := 0 to ScreenMax do
  96.    begin
  97.      PhByte := (CurCol+CurRow*succ(EndCol))+PhOfs;
  98.      gotoxy(succ(CurCol*4),succ(CurRow));
  99.      write('    ');
  100.      if PhByte < PhonemeSize then
  101.      begin
  102.        gotoxy(succ(CurCol*4),succ(CurRow));
  103.        write(SaData^[i+PhOfs+(pred(Ph) * PhonemeSize)]);
  104.      end;
  105.      inc(CurCol);
  106.      if CurCol > EndCol then
  107.      begin
  108.        CurCol := StartCol;
  109.        inc(CurRow);
  110.      end;
  111.    end;
  112.    gotoxy(PhCol,CmdRow);
  113.    write('[PgUp]/[PgDo] phoneme: ',PhArray[ph]);
  114.    ByteShow;
  115.    gotoxy(TalkCol,CmdRow);
  116.    write('[T]alk');
  117.    gotoxy(EdCol,CmdRow);
  118.    write('[E]dit');
  119.    gotoxy(SaveCol,CmdRow);
  120.    write('[S]ave');
  121.    gotoxy(SelectCol,CmdRow);
  122.    write('Select:',#24,#25,#26,#27);
  123.    if PhOfs = 0 then Mup := ' ' else Mup := #30;
  124.    if (EndRow*succ(EndCol))+PhOfs < PhonemeSize then Mdo := #31 else Mdo := ' ';
  125.    gotoxy(MoreCol,CmdRow);
  126.    write('More:',Mup,Mdo);
  127.    CurCol := OldCol;
  128.    CurRow := OldRow;
  129. end;
  130.  
  131. Procedure NextP;
  132. begin
  133.    CurCol := 0;
  134.    CurRow := 0;
  135.    PhOfs := 0;
  136.    inc(Ph);
  137.    if Ph > MaxPhoneme then Ph := 1;
  138.    clrscr;
  139.    ShowData;
  140.    TalkIt;
  141. end;
  142.  
  143. Procedure PrevP;
  144. begin
  145.    CurCol := 0;
  146.    CurRow := 0;
  147.    PhOfs := 0;
  148.    dec(Ph);
  149.    if Ph < 1 then Ph := MaxPhoneme;
  150.    clrscr;
  151.    ShowData;
  152.    TalkIt;
  153. end;
  154.  
  155. procedure ShiftUp;
  156. begin
  157.   if CurRow < succ(StartRow) then
  158.   begin
  159.     CurRow := StartRow;
  160.     if PhOfs > 0 then
  161.     begin
  162.       PhOfs := PhOfs-succ(EndCol);
  163.       ShowData;
  164.     end;
  165.   end
  166.   else
  167.     dec(CurRow);
  168. end;
  169.  
  170. procedure ShiftDo;
  171. begin
  172.   if CurRow > pred(EndRow) then
  173.   begin
  174.     CurRow := EndRow;
  175.     if PhOfs < MaxPhOfs then
  176.     begin
  177.       PhOfs := PhOfs+succ(EndCol);
  178.       ShowData;
  179.     end;
  180.   end
  181.   else
  182.     inc(CurRow);
  183. end;
  184.  
  185. procedure ShiftLf;
  186. begin
  187.   if CurCol = StartCol then
  188.   begin
  189.     CurCol := EndCol;
  190.   end
  191.   else
  192.     dec(CurCol)
  193. end;
  194.  
  195. procedure ShiftRi;
  196. begin
  197.   inc(CurCol);
  198.   if CurCol > EndCol then
  199.   begin
  200.     CurCol := StartCol;
  201.   end;
  202. end;
  203.  
  204. procedure HomeIt;
  205. begin
  206.   CurCol := 0;
  207.   CurRow := 0;
  208. end;
  209.  
  210. procedure EndIt;
  211. begin
  212.   CurCol := EndCol;
  213.   CurRow := EndRow;
  214. end;
  215.  
  216. procedure DoEdit;
  217. var ec,er,ei,ErrCode:word;
  218.     tb:byte;
  219.     OldNum,NewNum:string[8];
  220. begin
  221.    ec := EditCol+6;
  222.    er := EditRow;
  223.    if PhByte >= PhonemeSize then Exit;
  224.    HighVideo;
  225.    gotoxy(EditCol, EditRow);
  226.    write('Edit:    ');
  227.    gotoxy(EditCol+6,EditRow);
  228.    write(SaData^[PhByte+(pred(Ph) * PhonemeSize)]);
  229.    str(SaData^[PhByte+(pred(Ph) * PhonemeSize)],NewNum);
  230.    while length(NewNum) < 3 do NewNum := NewNum+' ';
  231.    ei := 1;
  232.    repeat
  233.      highVideo;
  234.      gotoxy(pred(ec)+ei,er);
  235.      if not(((Key >= '0') and (Key <= '9')) or (Key = ' ')) then
  236.        Key := ReadKey;
  237.      if Key = #$1b then
  238.      begin
  239.        LowVideo;
  240.        gotoxy(EditCol, EditRow);
  241.        write('         ');
  242.        Exit;
  243.      end;
  244.      if ((Key >= '0') and (Key <= '9')) or (Key = ' ') then
  245.      begin
  246.        OldNum := NewNum;
  247.        NewNum[ei] := Key;
  248.        while NewNum[length(NewNum)] = ' ' do dec(NewNum[0]);
  249.        while (NewNum[1] = ' ') and (length(NewNum) > 1) do
  250.          delete(NewNum,1,1);
  251.        val(NewNum,tb,ErrCode);
  252.        while length(NewNum) < 3 do NewNum := NewNum+' ';
  253.        if ErrCode <> 0 then
  254.          NewNum := OldNum
  255.        else
  256.        begin
  257.          gotoxy(ec,er);
  258.          write(NewNum);
  259.          if Key <> ' ' then inc(ei);
  260.          if ei > 3 then ei := 3;
  261.        end;
  262.      end;
  263.      if (Key = #8) and (ei > 1) then
  264.      begin
  265.        dec(ei);
  266.      end;
  267.      LowVideo;
  268.      if Key = #13 then
  269.      begin
  270.        HighVideo;
  271.        while NewNum[length(NewNum)] = ' ' do dec(NewNum[0]);
  272.        while NewNum[1] = ' ' do delete(NewNum,1,1);
  273.        val(NewNum,SaData^[PhByte+(pred(Ph) * PhonemeSize)],ErrCode);
  274.        gotoxy(succ(CurCol*4),succ(CurRow));
  275.        write('    ');
  276.        gotoxy(succ(CurCol*4),succ(CurRow));
  277.        write(SaData^[PhByte+(pred(Ph) * PhonemeSize)]);
  278.        gotoxy(EditCol, EditRow);
  279.        write('         ');
  280.        LowVideo;
  281.        Exit;
  282.      end;
  283.      Key := #0;
  284.    until false;
  285. end;
  286.  
  287. procedure CurShow(Sel:word);
  288. begin
  289.    gotoxy(succ(CurCol*4),succ(CurRow));
  290.    write('    ');
  291.    if Sel = 0 then LowVideo else HighVideo;
  292.    gotoxy(succ(CurCol*4),succ(CurRow));
  293.    if PhByte < PhonemeSize then
  294.      write(SaData^[PhByte+(pred(Ph) * PhonemeSize)]);
  295.    LowVideo;
  296. end;
  297.  
  298. procedure SaveIt;
  299. begin
  300.    gotoxy(RemCol, EditRow);
  301.    write('             ');
  302.    HighVideo;
  303.    gotoxy(EditCol, EditRow);
  304.    write('Save Image (Y/N) ? ');
  305.    gotoxy(EditCol+19,EditRow);
  306.    Key := upcase(ReadKey);
  307.    write(Key);
  308.    if Key = 'Y' then
  309.    begin
  310.      assign(fb,bkfile);
  311.      Erase(fb);
  312.      ReName(f,bkfile);
  313.      assign(f,rdfile);
  314.      ReWrite(f,1);
  315.      BlockWrite(f,SaData^,Fsize,Result);
  316.      Close(f);
  317.      HighVideo;
  318.      gotoxy(RemCol, EditRow);
  319.      write('<Image Saved>');
  320.    end;
  321.    LowVideo;
  322.    gotoxy(EditCol, EditRow);
  323.    write('                      ');
  324. end;
  325.  
  326. begin
  327.    TextAttr := LightGray;
  328.    ScreenMax := pred(succ(EndCol)*succ(EndRow));
  329.    MaxPhOfs := PhonemeSize - ScreenMax;
  330.    if MaxPhOfs < 0 then MaxPhOfs := 0;
  331.    Pg := 1;
  332.    Ph := 1;
  333.    PhOfs := 0;
  334.    PhByte := 0;
  335.    GetMem(SaData,sizeof(SaData^));
  336.    if ParamCount > 0 then
  337.       Assign(f,ParamStr(1))
  338.    else
  339.       Assign(f,rdfile);
  340.    reset(f,1);
  341.    Fsize := FileSize(f);
  342.    reset(f,1);
  343.    BlockRead(f,SaData^,Fsize,Result);
  344.    Close(f);
  345.    clrscr;
  346.    ShowData;
  347.    CurCol := 0;
  348.    CurRow := 0;
  349.    TalkIt;
  350.    repeat
  351.      PhByte := (CurCol+CurRow*succ(EndCol))+PhOfs;
  352.      ByteShow;
  353.      CurShow(1);
  354.      Key := upcase(ReadKey);
  355.      if Key = #0 then Key := char(byte(ReadKey) or $80);
  356.      if Key = 'E' then DoEdit;
  357.      if Key in ['0'..'9'] then DoEdit;
  358.      if (Key = 'X') or (Key = 'Q') then halt;
  359.      if Key = 'T' then TalkIt;
  360.      CurShow(0);
  361.      if Key = PgDo then NextP;
  362.      if Key = PgUp then PrevP;
  363.      if Key = UpAr then ShiftUp;
  364.      if Key = DoAr then ShiftDo;
  365.      if Key = LfAr then ShiftLf;
  366.      if Key = RiAr then ShiftRi;
  367.      if Key = Home then HomeIt;
  368.      if Key = EKey then EndIt;
  369.      if Key = 'D' then ShowData;
  370.      if Key = 'S' then SaveIt;
  371.    until false;
  372. end.
  373.